perm filename PGSUB.2[MSS,LCS] blob
sn#244645 filedate 1976-10-28 generic text, type C, neo UTF8
COMMENT ā VALID 00002 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 C**** VARIOUS SUBROUTINES FOR PAGE LAYOUT PROGRAM. ****
C00012 ENDMK
Cā;
C**** VARIOUS SUBROUTINES FOR PAGE LAYOUT PROGRAM. ****
SUBROUTINE FILOUT(NAMQ,NPG)
COMMON /FIN/JBAR,METR,REND,KPX,KREAD,JEND,JSLUR,JSL2,NAMZ
1,LC,LPG,MPG,CLEF,SIG,LB,SPG,MTR1,MTR2
1 /SF/KL,RT,KP,STFSZ,NAMX
MTR1=-1
MTR2=-1
NAMQ='AAAAA'
103 FORMAT(' TYPE OUTPUT FILE NAME ',$)
102 FORMAT(A5)
TYPE 103
ACCEPT 102,NAMX
IF(NAMX.EQ.' ')NAMX=NAMQ
NAMZ=NAMX
NPG=1
IF(LOOKF(NAMX).GE.0)GO TO 88
TYPE 88,NAMX
ACCEPT 102,L
IF(L.EQ.'N')GO TO 103
88 FORMAT(' WRITE OVER FILE ',A5,'???? '$)
END
SUBROUTINE METER(MTR,R)
COMMON /FIN/JBAR,METR,REND,KPX,KREAD,JEND,JSLUR,JSL2,NAMZ
1,LC,LPG,MPG,CLEF,SIG,LB,SPG,MTR1,MTR2
1/IPG/IPG,JPG,BRACK,RSTNUM(8),RPSZ(8),RHGT(8),RCLEF(-3/4)
1 /SF/KL,RT,KP,STFSZ,NAMX
K=MTR/100
B=MTR-K*100
A=K
J=LPG
1 RT=RSTNUM(J)
C RT (IN COMMON) TRANSFERS THE STAFF NUM. TO SUBR. STAFF
C PUT METER ON ALL STAVES FOR PAGE LAYOUT
CALL STAFF(4.,18.,R,0,A,B,0,0)
C PUTS IN METER AT START OF STAFF
J=J-1
IF(J.GT.0)GO TO 1
MTR=-1
END
SUBROUTINE FILEIN
COMMON /FIN/JBAR,METR,REND,KPX,KREAD,JEND,JSLUR,JSL2,NAMZ
1,LC,LPG,MPG,CLEF,SIG,LB,SPG,MTR1,MTR2
1/IPG/IPG,JPG,BRACK,RSTNUM(8),RPSZ(8),RHGT(8),RCLEF(-3/4)
1 /RSP/KNM(10),ENDLN,N,NAME,NMPG,T /KBAR/KBAR(512)
COMMON RS,JA,CLEFQ,AA,RQ(16),KQ,NQ,JQ,JJQ,KBQ,NAQ
COMMON /POSI/STFF(-3/4),JJ2,JPQ /LLL/L,LL,I,RXQ
COMMON/STF/RSTFAC(-3/4),RSTJ2 /PX/KPN(1) /Q/Q(1)
1 /NBAR/NBAR(36) /SIZE/SIZE
EQUIVALENCE (LASTNM,KBAR(3))
IF(NBAR(LC).EQ.0)CALL EXIT
IF(KPX.EQ.1)GO TO 104
C SKIP THIS FIRST TIME. IT SHUFFLES DATA FORWARD IN ARRAY.
J=KPX-1
JJ=KPN(KPX)-1
DO 105 K=1,NPX-J
105 KPN(K)=KPN(K+J)-JJ
J=KPN(NPX)-JJ
C HOW MUCH TO SHIFT THE Q ARRAY
DO 106 K=1,J
106 Q(K)=Q(K+JJ)
KPX =NPX-KPX+1
C UPDATE POINTERS FOR NEXT READIN
KQ=KPN(KPX)
JPX=KQ-1
104 KL=1
KP=1
JEND=0
C FLAG FOR PAGE END - WHEN -1
CC RT=2
CC J=KK
CC HGT=HX*2.
CC LD=0
CC MTR1=-1
CC K=KK-1
IF(LB.LT.NBAR(LC))GO TO 220
NPX=KPX
KPX=1
LB=0
GO TO 241
220 CALL GETFIL(NMPG)
CALL FASTIN(RSTFAC,22)
211 CALL FASTIN(KPN(KPX),JJ2)
CALL FASTIN(Q(KQ),JPQ)
IF(KPX.EQ.1)GO TO 140
DO 420 JP=KPX,JJ2+KPX-1
420 KPN(JP)=KPN(JP)+JPX
140 JPX=KQ+JPQ-3
C NUM OF WORDS TO SHIFT.
41 NMPG=NMPG+2
C NMPG = NAME OF INPUT FILES
CC L=JJ2-2
CC NPX=KPX+L
NPX=KPX+JJ2-2
241 JBAR=NBAR(LC)
DO 20 JP=KPX,NPX-1
N=KPN(JP)
IF(Q(N+1).NE.4)GO TO 20
C FINDS BAR LINES IN THIS PART OF DATA
LB=LB+1
IF(LB.NE.JBAR)GO TO 20
KPX=JP+1
520 IF(Q(KPN(KPX)+1).NE.18)GO TO 20
C LOOKS FOR METER BEYOND LAST BAR IN LINE
IF(KPX.GE.NPX)GO TO 20
KPX=KPX+1
GO TO 520
20 CONTINUE
IF(LB.GE.JBAR)GO TO 120
KPX=NPX
KQ=JPX+1
GO TO 220
120 KQ=KPN(KPX)
LB=LB-JBAR
L=KPX-1
C L=TOTAL ITEMS FOR THIS LINE. JBAR=TOTAL BARS, LB=HOW MANY LEFT OVER
I=L
IF(LB.NE.0)RETURN
KPX=1
KQ=1
END
SUBROUTINE STAVES
DATA SLSP/12.0/
DIMENSION BEG(500)
COMMON /FIN/JBAR,METR,REND,KPX,KREAD,JEND,JSLUR,JSL2,NAMZ
1,LC,LPG,MPG,CLEF,SIG,LB,SPG,MTR1,MTR2
COMMON /SF/KL,RT,KP,STFSZ,NAMX /IPG/IPG,JPG,BRACK,
1 RSTNUM(8),RPSZ(8),RHGT(8),RCLEF(-3/4)
1 /RSP/KNM(10),ENDLN,N,NAME,NMPG,T /KBAR/KBAR(512)
COMMON RS,JA,CLEFQ,AA,RQ(16),KQ,NQ,JQ,JJQ,KBQ,NAQ
COMMON/STF/RSTFAC(-3/4),RSTJ2 /IVV/OSLUR(1)
COMMON /POSI/STFF(-3/4),JJ2,JPQ /LLL/L,LL,I,RXQ
1/PX/KPN(1) /Q/Q(1) /PTR/KWDS(1) /XRN/RN(1) /NBAR/NBAR(36)
EQUIVALENCE (RQ(2),R4),(R5,RQ(3)),(R6,RQ(4)),(R7,RQ(5))
1,(R8,RQ(6)),(R9,RQ(7)),(BEG,RN(2001))
C BEG ARRAY WILL STORE END OF LINE CARRYOVER STUFF.
IF(LC.EQ.1)RA=0
C RA IS LEFT POS OF Q DATA. (IT SHIFTS AS LC CHANGES.)
KL=1
KP=1
LC=LC+1
335 RX=0
IF(NBAR(LC).EQ.0)JEND=-1
3 JJ=KP
C ******** PUTS IN STAFF ********
RS=3.
C RS IS WDCNT FOR SUBR. STAFF
IF(RT.NE.0)GO TO 331
C NEXT FOR BOTTOM STAFF. PUTS IN SPACER.
RS=6.
331 IF(IPG)GO TO 411
HX=8
RZ=0
RX=RT
DO 611 JP=1,LPG
RT=RSTNUM(JP)
RS=3
C WD CNT IS RS, HX IS CODE(8), ARRAYS AND LPG(JPG) WERE SET UP IN MAIN.
RR=0
IF(JP.GT.1)GO TO 611
IF(NAMX.EQ.NAMZ)GO TO 611
RS=6
RR=SPG
C FOR SPACER ON STAFF 0
611 CALL STAFF(RS,HX,RZ,RHGT(JP),RPSZ(JP),RZ,RZ,RR)
HX=LPG
RS=4.
RT=0
CALL STAFF(2.,RS,RZ,HX,RZ,RZ,RZ,RZ)
IF(BRACK.NE.0)CALL STAFF(5.,RS,RZ,HX,RZ,RZ,BRACK,RZ)
RT=RX
GO TO 511
411 CALL STAFF(RS,8.,0,HGT,RSTJ2,0,0,SP)
HGT=HGT-HX
511 IF(JEND)GO TO 60
C FOR PREMATURE PAGE END
CP IF(K.NE.I)GO TO 6
IF(RT.EQ.0)GO TO 6
60 IF(IPG.EQ.0)GO TO 6
RX=RT
RT=0
CALL STAFF(6.,8.,0,0,0,0,1.,SP)
C PUTS IN SPACER
RT=RX
6 IF(JSLUR.EQ.0)GO TO 333
C ***** PUT SLUR AT END OF LINE ********
JSLUR=0
K4=2
K5=3
K7=4
RT=OSLUR(1)
1333 CALL STAFF(5.,5.,0,OSLUR(K4),OSLUR(K5),SLSP,OSLUR(K7),0)
IF(JSL2.EQ.0)GO TO 333
C FOR 2ND SLUR AT END OF LINE.
JSL2=0
K4=6
K5=7
K7=8
RT=OSLUR(5)
GO TO 1333
C ****** NEXT FOR CLEFS ************
333 IF(CLEF.EQ.-99)GO TO 33
C ONLY STAFF FOR FIRST LINE AT TOP.
RX=8.*RSTJ2
C THE SPACER
LA=0
IF(IPG)GO TO 3011
LA=LPG
3111 RT=RSTNUM(LA)
LL=RT
CLEF=RCLEF(LL)
C GETS CLEF FOR PAGE LAYOUT, RT IS STAFF# IN CALL
LA=LA-1
3011 CALL STAFF(3.,3.,1.5,0,CLEF,0,0,0)
IF(SIG.EQ.-99)GO TO 3211
C ***** NEXT FOR KEY SIG. ********
RS=4.
R5=SIG
332 CALL STAFF(RS,17.,10.0*RSTJ2,0,R5,CLEF,0,0)
3211 IF(LA.GT.0)GO TO 3111
RX=11.*RSTJ2
C RX SETS POS OF NEXT ITEM ON STAFF
R7=RX
C ***** NEXT FOR METER CHANGES TO APPEAR AT START OF STAFF*****
33 IF(MTR1)GO TO 31
R=R7+RSTJ2*3
CALL METER(MTR1,R)
C PUT METER ON ALL STAVES FOR PAGE LAYOUT
C PUTS IN METER AT START OF STAFF
IF(MTR2)GO TO 5211
R=7.5*RSTJ2+R7
CALL METER(MTR2,R)
C PUTS COMPOSITE METER AFTER END OF STAFF
5211 RX=R+RSTJ2
C RX SPACES NEXT ITEM TO RIGHT OF LINE BEGINNING.
31 R4=RA
LA=I
231 K4=KPN(LA)
R=Q(K4+1)
IF(R.EQ.4)GO TO 131
LA=LA-1
GO TO 231
131 R5=Q(K4+3)
RS=0
R7=RT
R8=RX
R9=200.
LL=0
L=I
CALL PTMOVE(Q,KPN)
RA=R5
IF(LA.EQ.I)RETURN
C NEXT PUTS METER JUST BEYOND END OF LINE
R=202
R7=Q(KPN(LA+1)+3)
C R7 HOLDS STAFF NUM. FOR THINGS BEYOND END OF LINE.
DO 431 K5=LA+1,I
K7=KPN(K5)
K4=0
IF(Q(K7+1).EQ.18)K4=Q(K7+5)*100+Q(K7+6)
C K4 STORES METER (TOP*100+BOTTOM)
IF(Q(K7+3).EQ.R7)GO TO 531
R7=Q(K7+3)
C THIS PROBABLY WON'T ALWAYS DO THE RIGHT THING!!
R=R+5
IF(MTR1.GT.0.AND.K4.NE.0)MTR2=K4
531 IF(K4.NE.0.AND.MTR1)MTR1=K4
431 Q(K7+3)=R
END